home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / UNIXTOOL / GNU / PERL / PERL5.ZIP / !Perl / Lib / I18N / pm / Collate
Text File  |  1994-10-18  |  2KB  |  98 lines
  1. package I18N::Collate;
  2.  
  3. # Collate.pm
  4. #
  5. # Author:    Jarkko Hietaniemi <Jarkko.Hietaniemi@hut.fi>
  6. #        Helsinki University of Technology, Finland
  7. #
  8. # Acks:        Guy Decoux <decoux@moulon.inra.fr> understood
  9. #        overloading magic much deeper than I and told
  10. #        how to cut the size of this code by more than half.
  11. #        (my first version did overload all of lt gt eq le ge cmp)
  12. #
  13. # Purpose:      compare 8-bit scalar data according to the current locale
  14. #
  15. # Requirements:    Perl5 POSIX::setlocale() and POSIX::strxfrm()
  16. #
  17. # Exports:    setlocale 1)
  18. #        collate_xfrm 2)
  19. #
  20. # Overloads:    cmp # 3)
  21. #
  22. # Usage:    use Collate;
  23. #            setlocale(&LC_COLLATE, 'locale-of-your-choice'); # 4)
  24. #        $s1 = new Collate "scalar_data_1";
  25. #        $s2 = new Collate "scalar_data_2";
  26. #        
  27. #        now you can compare $s1 and $s2: $s1 le $s2
  28. #        to extract the data itself, you need to deref: $$s1
  29. #        
  30. # Notes:    
  31. #        1) this uses POSIX::setlocale
  32. #        2) the basic collation conversion is done by strxfrm() which
  33. #           terminates at NUL characters being a decent C routine.
  34. #           collate_xfrm handles embedded NUL characters gracefully.
  35. #        3) due to cmp and overload magic, lt le eq ge gt work also
  36. #        4) the available locales depend on your operating system;
  37. #           try whether "locale -a" shows them or the more direct
  38. #           approach "ls /usr/lib/nls/loc" or "ls /usr/lib/nls".
  39. #           The locale names are probably something like
  40. #           'xx_XX.(ISO)?8859-N'.
  41. #
  42. # Updated:    19940913 1341 GMT
  43. #
  44. # ---
  45.  
  46. use POSIX qw(strxfrm LC_COLLATE);
  47.  
  48. require Exporter;
  49.  
  50. @ISA = qw(Exporter);
  51. @EXPORT = qw(collate_xfrm setlocale LC_COLLATE);
  52. @EXPORT_OK = qw();
  53.  
  54. %OVERLOAD = qw(
  55. fallback    1
  56. cmp        collate_cmp
  57. );
  58.  
  59. sub new { my $new = $_[1]; bless \$new }
  60.  
  61. sub setlocale {
  62.  my ($category, $locale) = @_[0,1];
  63.  
  64.  POSIX::setlocale($category, $locale) if (defined $category);
  65.  # the current $LOCALE 
  66.  $LOCALE = $locale || $ENV{'LC_COLLATE'} || $ENV{'LC_ALL'} || '';
  67. }
  68.  
  69. sub C {
  70.   my $s = ${$_[0]};
  71.  
  72.   $C->{$LOCALE}->{$s} = collate_xfrm($s)
  73.     unless (defined $C->{$LOCALE}->{$s}); # cache when met
  74.  
  75.   $C->{$LOCALE}->{$s};
  76. }
  77.  
  78. sub collate_xfrm {
  79.   my $s = $_[0];
  80.   my $x = '';
  81.   
  82.   for (split(/(\000+)/, $s)) {
  83.     $x .= (/^\000/) ? $_ : strxfrm("$_\000");
  84.   }
  85.  
  86.   $x;
  87. }
  88.  
  89. sub collate_cmp {
  90.   &C($_[0]) cmp &C($_[1]);
  91. }
  92.  
  93. # init $LOCALE
  94.  
  95. &I18N::Collate::setlocale();
  96.  
  97. 1; # keep require happy
  98.